Dim ws As Workspace
Dim DB As Database
Dim Archivo As Recordset
____________________________________________________
Private Sub Command1_Click()

Dim Libro As Excel.Workbook
Dim Hoja As Excel.Worksheet
Dim Fila As Integer, Columna As Integer
Dim Contenido As String, Lineas As Variant
Dim f As Long, c As Long
Dim w As Worksheet
' Dim Directorio As String

' Dim datos As Variant, MC As Integer
Dim datos As String, MC As Integer

' Dim i%, fila%
' Dim NombreHoja As Integer

'On Error GoTo errorcito

' Directorio = App.Path

Set Libro = GetObject("h:\app\cts\hojas\CTS Modelo vacio.xls")

Set ws = DBEngine.Workspaces(0)
Set DB = ws.OpenDatabase("h:\app\cts\hojas", False, False, "FoxPro 2.6;")

Set Archivo = DB.OpenRecordset("L000001.dbf", dbOpenDynaset)

Do While Not Archivo.EOF

   Libro.Sheets("CLIENTES").Select
   Set Hoja = Libro.Worksheets("CLIENTES")
        
' Aadir lneas de cdigo para llenar el archivo xls
   
f = 1
' While Not Archivo.EOF
For c = 0 To Archivo.Fields.Count - 1
Hoja.Cells(f + 1, c + 1) = Archivo.Fields(c).Value
Next c
f = f + 1
Archivo.MoveNext
Loop

' Set DB = ws.OpenDatabase("c:\app\hojas", False, False, "FoxPro 2.6;")
' Set Archivo = DB.OpenRecordset("sec.dbf", dbOpenDynaset)

' Do While Not Archivo.EOF

'  NombreHoja = Trim(Archivo!Pregunta)

'   Libro.Sheets(NombreHoja).Select
'   Set Hoja = Libro.Worksheets(NombreHoja)
        
'   Hoja.Cells(6, 2) = Trim(Archivo!Data)
    
'   Archivo.MoveNext
' Loop

Libro.Sheets(1).Select
Libro.Windows.Application.Visible = True
Hoja.Application.Windows(1).Visible = True

With Libro
' .SaveAs filename:="H:\App\cts\hojas" & "\" & "CTS.xls"
' .SaveAs filename:=Directorio & "\" & "CTS.xls"
' .SaveAs filename:="H:\App\cts\hojas\CTS.xls"

    .Close
End With
    
Unload Me
End Sub

